'Modifications
'06/10/17 et 12/10/17 suite a ajout d'une colonne F "Budget Conforme" dans feuille Details

'----------------------------------------------------------------------------------------------------
'Module pour la feuille Details
'Noms _ ne pas changer : AUTRES MATERIAUX,
Option Explicit
Public ligvf, ligvm, ligvc
Public dlg As Integer
Public dcl As Byte
Sub CopieMatrice()
'Macro Dan pour Sofiacasandra - 10/05/17

Dim chemin As String, fichier As String
Dim dlgM As Integer, plgM As Integer, dlgD As Integer
ActiveSheet.Unprotect 'deproteger la feuille Details
With Application
    .DisplayAlerts = False
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
End With
With ThisWorkbook.Sheets("DETAILS")
    dlgD = .Range("A" & .Rows.Count).End(xlUp).Row
End With
chemin = ThisWorkbook.Path & Application.PathSeparator
fichier = "Matrice.xlsx"
On Error Resume Next
Workbooks.Open Filename:=chemin & fichier
If Err > 0 Then GoTo Fin
On Error GoTo 0

'Modification 21/11/17
Dim lgD As Integer, lgM As Integer
With Workbooks(fichier).Sheets(1)
'Verification existance du code OTP dans le fichier Matrice depuis la feuille Details et suppression eventuelle dans feuille Details
For lgD = dlgD To 8 Step -1
    On Error Resume Next
    lgM = .Range("A:A").Find(ThisWorkbook.Sheets("Details").Range("A" & lgD), LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True).Row
    If lgM = 0 Then ThisWorkbook.Sheets("Details").Rows(lgD).Delete
    lgM = 0
Next lgD
End With
On Error GoTo 0
'importation des donnees depuis fichier Matrice - Modifie le 22/11/17 - Dan
With Workbooks(fichier).Sheets(1)
    dlgM = .Range("A" & .Rows.Count).End(xlUp).Row 'Derniere ligne du fichier Matrice
    plgM = .Range("B:B").Find(What:="AUTRES MATERIAUX", LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True).Row 'Premiere ligne fichier Matrice
    For lgM = plgM To dlgM
        On Error Resume Next
        lgD = ThisWorkbook.Sheets("Details").Range("A:A").Find(.Range("A" & lgM), LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True).Row
        If lgD = 0 Then
            lgD = lgM - plgM + 8
            ThisWorkbook.Sheets("DETAILS").Rows(lgD).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        End If

        .Range("A" & lgM & ":B" & lgM).Copy ThisWorkbook.Sheets("DETAILS").Range("A" & lgD)
        .Range("C" & lgM & ":C" & lgM).Copy ThisWorkbook.Sheets("DETAILS").Range("F" & lgD)
        .Range("D" & lgM & ":E" & lgM).Copy ThisWorkbook.Sheets("DETAILS").Range("D" & lgD)
        .Range("G" & lgM & ":G" & lgM).Copy ThisWorkbook.Sheets("DETAILS").Range("H" & lgD)
        .Range("I" & lgM & ":J" & lgM).Copy ThisWorkbook.Sheets("DETAILS").Range("I" & lgD)
       
        If lgD <> lgM - plgM + 8 Then 'verification pour verifier si la ligne de la feuille details correspond a la ligne de la feuille Matrice
            'MsgBox lgD
            'MsgBox lgM - plgM + 8
            With ThisWorkbook.Sheets("Details")
                .Rows(lgD).Cut
                .Rows(lgM - plgM + 8).Insert Shift:=xlDown
            End With
        End If
            lgD = 0
    Next

End With

'importation des donnees depuis fichier Matrice
'With Workbooks(fichier).Sheets(1)
'    dlg = .Range("A" & .Rows.Count).End(xlUp).Row 'Derniere ligne du fichier Matrice
'    plg = .Range("B:B").Find(What:="AUTRES MATERIAUX", LookIn:=xlValues, MatchCase:=True).Row 'Premiere ligne fichier Matrice
'    'Suppression des lignes en trop dans feuille Details avant importation des donnees depuis Matrice
'    If dlgD > dlg - plg + 8 Then ThisWorkbook.Sheets("DETAILS").Rows(dlg - plg + 1 & ":" & dlgD - 1).Delete
'    .Range("A" & plg & ":B" & dlg).Copy ThisWorkbook.Sheets("DETAILS").Range("A8")
'    .Range("C" & plg & ":C" & dlg).Copy ThisWorkbook.Sheets("DETAILS").Range("F8") 'Modifie le 12/10/17 - Dan
'    .Range("D" & plg & ":E" & dlg).Copy ThisWorkbook.Sheets("DETAILS").Range("D8") 'Ajout le 12/10/17 - Dan
'    .Range("G" & plg & ":G" & dlg).Copy ThisWorkbook.Sheets("DETAILS").Range("H8") 'Modifie le 06/10/17 - Dan
'    .Range("I" & plg & ":J" & dlg).Copy ThisWorkbook.Sheets("DETAILS").Range("I8") 'Modifie le 06/10/17 - Dan
'End With
Workbooks(fichier).Close savechanges:=False

Call Formules 'macro pour les formules et mise en forme

With Application
    .Calculation = xlCalculationAutomatic
    .DisplayAlerts = True
    .ScreenUpdating = True
End With
ActiveSheet.Protect 'proteger la feuille Details
Exit Sub
Fin:  MsgBox "Le fichier " & fichier & " ne peut etre ouvert, Verifiez que :" & vbCrLf & _
"- L'ortographe du nom Matrice" & vbCrLf & _
"- L'extension est bien XLSX" & vbCrLf & _
"- Le fichier " & fichier & " est bien dans le mme repertoire que ce fichier."
ActiveSheet.Protect 'proteger la feuille Details
End Sub


Sub Formules()
'Macro Dan pour Sofiacasandra - 10/05/17
'Modifie pour supprimer formules en colonne qte et PU Rad - Dan - 19/10/17
Dim i As Integer ', j As Integer
Dim temp As String, Temp2 As String, Temp3 As String
Dim k As Byte, x As Byte, y As Byte

With ThisWorkbook.Sheets("DETAILS")
    Call Alimentation_Lignes 'macro pour recherche lignes vert fonce
    
    dlg = .Range("A" & .Rows.Count).End(xlUp).Row 'derniere ligne
    dcl = .Cells(6, .Columns.Count).End(xlToLeft).Column 'derniere colonne
    .Range(.Cells(8, dcl - 4), .Cells(dlg, dcl)).ClearContents 'Suppression des donnees colonnes RAD et Cumul chantier
    
    For i = dlg To 8 Step -1
        .Range(.Cells(i, dcl - 4), .Cells(i, dcl)).Interior.Color = .Range("B" & i).Interior.Color
        
        .Cells(i, 3).FormulaR1C1 = "=RC[3]-RC[1]-RC[2]" 'Ajout formule dans colonne C - Modifie le 12/10/17 - Dan

        Select Case .Cells(i, dcl - 4).Interior.Color
            Case Is = 14739672 'vert clair
                
                .Cells(i, dcl - 4).FormulaR1C1 = "=SUM(RC[-2]:RC[" & -dcl + 15 & "])"
                .Cells(i, dcl - 3).FormulaR1C1 = "=IFERROR(IF(RC[" & -dcl + 9 & "]-RC[" & -dcl + 12 & "]<0,0,RC[" & -dcl + 9 & "]-RC[" & -dcl + 12 & "]),0)"
                '.Cells(i, dcl - 2).FormulaR1C1 = "=IFERROR(RC[-2]*RC[-1],0)"
                .Cells(i, dcl - 1).FormulaR1C1 = "=RC[" & -dcl + 10 & "]+RC[-1]" 'Modifie le 06/10/17 - Dan
                .Cells(i, dcl).FormulaR1C1 = "=RC[" & -dcl + 6 & "]-RC[-1]" 'Modifie le 06/10/17 - Dan

                If y < UBound(ligvc) Then y = y + 1
                If Temp3 > "" Then
                    .Cells(i, dcl - 2).FormulaR1C1 = "=" & Temp3 & ""
                    Temp3 = ""
                    Else: .Cells(i, dcl - 2).FormulaR1C1 = "=IFERROR(RC[-2]*RC[-1],0)"
                End If
                 Temp2 = Temp2 & "+R[" & i - Val(ligvm(x)) & "]C"

            Case Is = 16777215 'Blanc

                .Cells(i, dcl - 4).FormulaR1C1 = "=SUM(RC[-2]:RC[" & -dcl + 15 & "])"
                .Cells(i, dcl - 3).FormulaR1C1 = "=IFERROR(IF(RC[" & -dcl + 9 & "]-RC[" & -dcl + 12 & "]<0,0,RC[" & -dcl + 9 & "]-RC[" & -dcl + 12 & "]),0)"
                .Cells(i, dcl - 2).FormulaR1C1 = "=IFERROR(RC[-2]*RC[-1],0)"
                .Cells(i, dcl - 1).FormulaR1C1 = "=RC[" & -dcl + 10 & "]+RC[-1]" 'Modifie le 06/10/17 - Dan
                .Cells(i, dcl).FormulaR1C1 = "=RC[" & -dcl + 6 & "]-RC[-1]" 'Modifie le 06/10/17 - Dan
                If .Cells(i, 1).Font.Bold = True Then Temp3 = Temp3 & "+R[" & i - Val(ligvc(y)) & "]C"

            Case Is = 12897954 'vert moyen

                If x < UBound(ligvm) Then x = x + 1
                    If Temp2 = "" Then
                        'cas applicable si la derniere ligne est en vert moyen au lieu de vert clair
                        .Cells(i, dcl - 4).FormulaR1C1 = "=SUM(RC[-2]:RC[" & -dcl + 15 & "])"
                        .Cells(i, dcl - 3).FormulaR1C1 = "=IFERROR(IF(RC[" & -dcl + 6 & "]-RC[" & -dcl + 11 & "]<0,0,RC[" & -dcl + 6 & "]-RC[" & -dcl + 11 & "]),0)"
                        .Cells(i, dcl - 2).FormulaR1C1 = "=IFERROR(RC[-2]*RC[-1],0)"
                        .Cells(i, dcl - 1).FormulaR1C1 = "=RC[" & -dcl + 9 & "]+RC[-1]"
                        .Cells(i, dcl).FormulaR1C1 = "=RC[" & -dcl + 3 & "]-RC[-1]"
                    Else: .Range(.Cells(i, dcl - 2), .Cells(i, dcl)) = "=" & Temp2 & "" 'Modifie le 19/10/17 - Dan
                    End If
                    Temp2 = ""
                    temp = temp & "+R[" & i - Val(ligvf(k)) & "]C"
               
            Case Is = 11581042 'vert fonce

                If k < UBound(ligvf) Then k = k + 1
                .Range(.Cells(i, dcl - 2), .Cells(i, dcl)) = "=" & temp & "" 'Modifie le 19/10/17 - Dan
                temp = ""
        End Select
    Next
End With
Call MiseForme
End Sub
Sub Alimentation_Lignes()
'Macro Dan pour Sofiacasandra - 10/05/17

Dim j As Integer, x As Integer
Dim temp As String, Temp2 As String, Temp3 As String
Dim CouleurVf As String, CouleurVm As String, CouleurVc As String

'On determine la couleur du fond.
CouleurVf = 11581042 'couleur de fond vert fonce
CouleurVm = 12897954  'couleur de fond vert moyen
CouleurVc = 14739672 'couleur de font vert clair

'On boucle pour connaitre les lignes vertes fonces et vert moyen
With ThisWorkbook.Sheets("DETAILS")
dlg = .Range("A" & .Rows.Count).End(xlUp).Row
For j = dlg To 8 Step -1
    If .Cells(j, 1).Interior.Color = CouleurVf Then
        If temp = "" Then
            temp = j
        Else
            temp = temp & ":" & j
        End If
    End If
    If .Cells(j, 1).Interior.Color = CouleurVm Then
        If Temp2 = "" Then
            Temp2 = j
        Else
            Temp2 = Temp2 & ":" & j
        End If
    End If
    If .Cells(j, 1).Interior.Color = CouleurVc Then
        If Temp3 = "" Then
            Temp3 = j
        Else
            Temp3 = Temp3 & ":" & j
        End If
    End If

Next j
End With

ligvf = Split(temp, ":") 'on determine le nombre de lignes qui seront vert fonce
ligvm = Split(Temp2, ":") 'on determine le nombre de lignes qui seront vert moyen
ligvc = Split(Temp3, ":") 'on determine le nombre de lignes qui seront vert clair
End Sub
Sub MiseForme()
'Macro Dan pour Sofiacasandra - 10/05/17
Dim i As Byte, plgD As Byte

With ThisWorkbook.Sheets("DETAILS")
    .Rows("8:" & dlg).RowHeight = 25 'hauteur de lignes
    'Mise en forme colonne F du fichier point - Modifie le 06/10/17 - Dan
    .Range("E8:E" & dlg).Copy
    .Range("C8").PasteSpecial Paste:=xlFormats
End With

plgD = 6 'premiere ligne feuille Detail
'Mise en forme Plage planning
ThisWorkbook.Sheets("DETAILS").Range(Cells(plgD + 1, 12), Cells(dlg, dcl - 6)).Font.Bold = True

With ThisWorkbook.Sheets("DETAILS").Range(Cells(plgD, 12), Cells(dlg, dcl - plgD))
    For i = 12 To dcl - 7 'Modifie le 06/10/17 - Dan
        If ThisWorkbook.Sheets("DETAILS").Cells(plgD, i) = 12 Then
            With ThisWorkbook.Sheets("DETAILS").Range(Cells(plgD, i), Cells(dlg, i))
                With .Borders(xlEdgeRight)
                    .LineStyle = xlContinuous
                    .Weight = xlThin
                    .ColorIndex = 1
                End With
            End With
        Else
            With ThisWorkbook.Sheets("DETAILS").Range(Cells(plgD, i), Cells(dlg, i))
                With .Borders(xlEdgeRight)
                    .LineStyle = xlContinuous
                    .Weight = xlHairline
                    .ColorIndex = 1
                End With
            End With
        End If
    Next i
    .Borders(xlInsideHorizontal).LineStyle = xlNone
    .BorderAround LineStyle:=xlContinuous, ColorIndex:=1, Weight:=xlThin
End With

'Mise en forme Plage A a F

With ThisWorkbook.Sheets("DETAILS").Range("A8:B" & dlg, "C8:F" & dlg) 'Modifie le 06/10/17 - Dan
    .BorderAround LineStyle:=xlContinuous, ColorIndex:=1, Weight:=xlMedium
    With .Borders(xlInsideHorizontal)
        .ColorIndex = 1
        .Weight = xlHairline
    End With
    With .Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = 1
    End With
End With
With ThisWorkbook.Sheets("DETAILS").Range("C8:C" & dlg)
    With .Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = 1
    End With
End With

'Mise en forme Plage H a J

With ThisWorkbook.Sheets("DETAILS").Range("H8:J" & dlg) 'Modifie le 06/10/17 - Dan
    .BorderAround LineStyle:=xlContinuous, ColorIndex:=1, Weight:=xlMedium
    With .Borders(xlInsideHorizontal)
        .ColorIndex = 1
        .Weight = xlHairline
    End With
    With .Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = 1
    End With
End With

With ThisWorkbook.Sheets("DETAILS").Range(Cells(8, dcl - 4), Cells(dlg, dcl))
    .BorderAround LineStyle:=xlContinuous, ColorIndex:=1, Weight:=xlMedium
    With .Borders(xlInsideHorizontal)
        .ColorIndex = 1
        .Weight = xlHairline
    End With
    With .Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = 1
    End With
End With

With ThisWorkbook.Sheets("DETAILS").Range(Cells(8, dcl - 4), Cells(dlg, dcl - 2))
    .BorderAround LineStyle:=xlContinuous, ColorIndex:=1, Weight:=xlMedium
    With .Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = 1
    End With
End With
End Sub
